ADA Programming Guide/ADA Programming Guide.iso/ada_tut/ada_tutr.ada

Text File | 1996-01-30 | 25.9 KB | 520 lines

-- ADA_TUTR.ADA   Ver. 3.00   22-AUG-1994   Copyright 1988-1994 John J. Herro
-- Software Innovations Technology
-- 1083 Mandarin Drive NE, Palm Bay, FL  32905-4706   [phone]
--
-- Before compiling this file, you must compile ONE of the following:
--
--    JANUS16.PKG   Recommended when using a PC with 16-bit Janus/Ada.
--    JANUS32.PKG   Recommended when using a PC with 32-bit Janus/Ada.
--    MERIDIAN.ADA  Recommended when using a PC with a Meridian Ada compiler.
--    UNIX.ADA      Recommended for UNIX based systems, if you can also
--                     compile ONECHAR.C or ALTCHAR.C with a C compiler and
--                     link with Ada.
--    VAX.ADA       Recommended when using VAX Ada.
--    VANILLA.ADA   "Plain vanilla" version for all other systems.  Should work
--                     with ANY standard Ada compiler.  On some systems,
--                     VANILLA.ADA may require you to strike ENTER after each
--                     response.  However, you don't have to strike ENTER with
--                     recent versions of TeleGen Ada by Telesoft.
--
-- See the PRINT.ME file for more information on installing ADA-TUTR on other
-- computers.
--
--
-- Before Running ADA-TUTR on a PC:
--
-- ADA-TUTR uses ANSI escape sequences for highlighting, cursor positioning,
-- reverse video, etc.  Before ADA-TUTR will work correctly on a PC, you must
-- install the device driver ANSI.SYS, which came with your copy of DOS.  To
-- install ANSI.SYS, do the following:
--
-- 1.  If there's a file CONFIG.SYS in the root directory of the disk from
--     which you boot, type it and look for a line saying "DEVICE=ANSI.SYS"
--     (without the quotes), in either upper or lower case.  If that line isn't
--     present, add it to CONFIG.SYS anywhere in the file, using an ordinary
--     text editor or word processor in the non-document mode.  If there's no
--     CONFIG.SYS file, create one containing the single line "DEVICE=ANSI.SYS"
--     (without the quotes).
--
-- 2.  If there's no file ANSI.SYS in your root directory, copy ANSI.SYS from
--     your DOS distribution diskette to the root directory of the disk from
--     which you boot.
--
-- 3.  Reboot the computer.  ADA-TUTR should then work correctly.
--

-- Introduction:
--
-- ADA-TUTR provides interactive instruction in the Ada programming language,
-- allowing you to learn at your own pace.  On a PC, access to an Ada compiler
-- is helpful, but not required.  You can exit this program at any time by
-- striking X, and later resume the session exactly where you left off.  If you
-- have a color monitor, you can set the foreground, background, and border
-- colors at any time by typing S.
--
-- ADA-TUTR presents a screenful of information at a time.  Screens are read
-- in 64-byte blocks from the random access file ADA_TUTR.DAT, using Direct_IO.
-- For most screens, ADA-TUTR waits for you to strike one character to
-- determine which screen to show next.  Screens are numbered starting with
-- 101; each screen has a three-digit number.  Screens 101 through 108 have
-- special uses, as follows:
--
-- 101 - This screen is presented when you complete the Ada course.  It
--       contains a congratulatory message.  After this screen is shown,
--       control returns directly to the operating system; the program doesn't
--       wait for you to strike a character.
-- 102 - This screen is presented when you exit ADA-TUTR before completing the
--       course.  After this screen is shown, control returns directly to the
--       operating system; the program doesn't wait for you to strike a
--       character.
-- 103 - This screen is shown whenever you strike X.  It displays the number of
--       the last screen shown and the approximate percentage through the
--       course.  It then asks if you want to exit the program.  If you strike
--       Y, screen 102 is shown and control returns to the operating system.
--       If you type N, screen 108 is shown to provide a menu of further
--       choices.  From screen 103, you can also strike M to see the main menu
--       (screen 106).
-- 104 - This is the opening screen.  It asks if you've used ADA-TUTR before.
--       If you strike N, a welcome screen is presented and the course begins.
--       If you strike Y, screen 107 is shown.
-- 105 - This screen allows you to type the number of the next screen you want
--       to see.  For this screen, instead of striking one character, you type
--       a three-digit number and presses ENTER.  Any number from 104 through
--       the largest screen number is accepted.
-- 106 - This screen contains the main menu of topics covered in ADA-TUTR.
--       When you select a main topic, an appropriate sub-menu is shown.
-- 107 - This screen is shown when you say that you've used ADA-TUTR before.
--       It says "Welcome back!" and provides a menu that lets you resume where
--       you left off, go back to the last question or Outside Assignment, go
--       to the main menu (screen 106), or go to any specified screen number
--       (via screen 105).
-- 108 - This screen is shown when you answer N to screen 103.  It provides a
--       menu similar to screen 107, except that the first choice takes you
--       back to the screen shown before you saw 103.  For example, if you
--       strike X while viewing screen 300, you'll see screen 103.  If you then
--       answer N, you'll see screen 108.  From 108 the first menu selection
--       takes you back to 300.
--

-- Format of the Data File:
--
-- ADA-TUTR.DAT is a random access file of 64-byte blocks.  The format of this
-- file changed considerably with version 2.00 of ADA-TUTR.  It's now much more
-- compact, and, although it's still a data file, it now contains only the 95
-- printable ASCII characters.
--
-- The first block of ADA_TUTR.DAT is referred to as block 1, and the first 35
-- blocks together are called the index.  Bytes 2 through 4 of block 1 contain,
-- in ASCII, the number of the welcome screen that's shown when you say that
-- you haven't used ADA-TUTR before.  Bytes 6 through 8 of block 1 contain the
-- number of the highest screen in the course.  (Bytes 1 and 5 of block 1
-- contain spaces.)
--
-- Bytes 9 of block 1 through the end of block 31 contain four bytes of
-- information for each of the possible screens 101 through 658.  For example,
-- information for screen 101 is stored in bytes 9 through 12 of block 1, the
-- next four bytes are for screen 102, etc.  For screens that don't exist, all
-- four bytes contain spaces.
--
-- The first of the four bytes is A if the corresponding screen introduces an
-- Outside Assignment, Q if the screen asks a question, or a space otherwise.
-- The next two bytes give the number of the block where data for the screen
-- begins, in base 95!  A space represents 0, ! represents 1, " represents 2,
-- # represents 3, $ represents 4, etc., through all the printable characters
-- of the ASCII set.  A tilde (~) represents 94.
--
-- The last of the four bytes gives the position, 1 through 64, within the
-- block where the data for this screen starts.  Again, ! represents 1,
-- " represents 2, # represents 3, etc.
--
-- Data for the screens are stored starting in position 1 of block 36.  In the
-- screen data, the following characters have special meaning:
--
--           %  turns on high intensity.
--           @  displays the number of spaces indicated by the next
--                 character (# represents 3, $ represents 4, etc.)
--           \  turns on reverse video and leaves one space.
--           ^  turns on high intensity and leaves one space.
--           `  restores normal video.
--           {  causes CR-LF.
--           }  moves cursor to row 24, column 1, for a prompt.
--           ~  restores normal video and leaves one space.
--
-- These characters have special meaning in screen 103 only:
--
--           #  shows approximate percentage through the course.
--           $  shows the number of the screen seen before 103.
--
-- Immediately after }, b represents "Please type a space to go on, or B to go
-- back." and q represents "Please type a space to go on, or B or Q to go back
-- to the question."
--

--
-- The data for each screen is followed by the "control information" for that
-- screen, in square brackets.  The control information is a list of characters
-- that you might strike after seeing this screen.  Each character is followed
-- by the three-digit number of the next screen to be shown when that character
-- is struck.  For example, Y107N122 is the control information for screen 104.
-- This means that if you strike Y, screen 107 will be shown next, and if you
-- strikes N, screen 122 will be shown.  Striking any other character will
-- simply cause a beep (except that X can always be typed to exit the program,
-- S can always be typed to set colors, and CR will be ignored).  If the
-- control information is simply #, you are prompted to type the next screen
-- number.  This feature is used in screen 105.
--
-- A "screen number" of 098 following a character means "go back to the last
-- Outside Assignment," and 099 means "go back to the last question."  These
-- special numbers are used in screens 107 and 108.  Number 100 means "go back
-- to the previous screen seen."
--
-- ADA-TUTR opens the Data File in In_File mode for read-only access.
--
--
--
-- Format of the User File:
--
-- The User File ADA_TUTR.USR initially doesn't exist.  It's created the first
-- time ADA-TUTR is run.
--
-- ADA_TUTR.USR is a random access file containing one 64-byte block.  Bytes 2
-- through 4 contain, in ASCII, the number of the last screen read the last
-- time you ran ADA-TUTR.  Byte 6 contains a digit for the foreground color you
-- select, byte 8 contains a digit for the background color, and byte 10
-- contains a digit for the border color.  All other bytes contain spaces.  The
-- ASCII characters '0' through '7' represent black, red, green, yellow, blue,
-- magenta, cyan, and white, in that order.  Note that not all color PCs have a
-- separate border color.  ADA_TUTR.USR is a random access file so that it can
-- be easily updated by Ada.  It contains 64 bytes so that it can be accessed
-- with the same package, namely Random_IO, that accesses the Data File.
--
-- If the User File exists, ADA-TUTR opens it in Inout_File mode for read/write
-- access.  If it doesn't exist, ADA-TUTR creates it.
--

with Custom_IO, Direct_IO; use Custom_IO;
procedure Ada_Tutr is
   subtype Block_Subtype is String(1 .. 64);
   package Random_IO is new Direct_IO(Block_Subtype); use Random_IO;
   IxSize      : constant := 35;              -- Number of blocks in the index.
   Data_File   : File_Type;            -- The file from which screens are read.
   User_File   : File_Type;          -- Remembers last screen seen, and colors.
   Block       : Block_Subtype;                -- Buffer for random-access I/O.
   Vpos        : Integer;                       -- Number of the current block.
   Hpos        : Integer;             -- Current position within current block.
   SN, Old_SN  : Integer := 104;        -- Screen num. and previous screen num.
   Quitting_SN : Integer := 104;           -- Screen number where you left off.
   Highest_SN  : Integer;               -- Highest screen number in the course.
   Welcome_SN  : Integer;           -- Number of the screen shown to new users.
   Indx        : String(1 .. 64*IxSize);           -- Index from the Data File.
   Files_OK    : Boolean := False;        -- True when files open successfully.
   Legal_Note  : constant String := " Copyright 1988-94 John J. Herro ";
                       -- Legal_Note isn't used by the program, but it causes
                       -- most compilers to place this string in the .EXE file.
   procedure Open_Data_File is separate;
   procedure Open_User_File is separate;
   procedure Show_Current_Screen is separate;
   procedure Get_Next_Screen_Number is separate;
begin
   Open_Data_File;
   Open_User_File;
   if Files_OK then
      Set_Border_Color(To => Border_Color);              -- Set default colors.
      Put(Normal_Colors);
      while SN > 0 loop          -- "Screen number" of 0 means end the program.
         Put(Clear_Scrn);                                  -- Clear the screen.
         Show_Current_Screen;
         Get_Next_Screen_Number;
      end loop;
      Block := (others => ' ');       -- Write user-specific data to user file.
      Block(1 .. 4) := Integer'Image(Quitting_SN);
      Block(6)  := Fore_Color_Digit;
      Block(8)  := Back_Color_Digit;
      Block(10) := Character'Val(Color'Pos(Border_Color) + 48);
      Write(User_File, Item => Block, To => 1);
      Close(Data_File);
      Close(User_File);
   end if;
end Ada_Tutr;

separate (Ada_Tutr)
procedure Open_Data_File is
   Data_File_Name : constant String := "ADA_TUTR.DAT";
begin
   Open(Data_File, Mode => In_File, Name => Data_File_Name);
   for I in 1 .. IxSize loop             -- Read index from start of Data File.
      Read(Data_File, Item => Block, From => Count(I));
      Indx(64*I - 63 .. 64*I) := Block;
   end loop;
   Welcome_SN := Integer'Value(Indx(2 .. 4));
   Highest_SN := Integer'Value(Indx(6 .. 8));
   Files_OK := True;
exception
   when Name_Error =>
      Put("I'm sorry.  The file " & DATA_FILE_NAME);
      Put_Line(" seems to be missing.");
   when others =>
      Put("I'm sorry.  The file " & DATA_FILE_NAME);
      Put_Line(" seems to have the wrong form.");
end Open_Data_File;



separate (Ada_Tutr)
procedure Open_User_File is
   User_File_Name : constant String := "ADA_TUTR.USR";
begin
   Open(User_File, Mode => Inout_File, Name => User_File_Name);
   Read(User_File, Item => Block, From => 1);
   Quitting_SN      := Integer'Value(Block(1 .. 4));
   Old_SN           := Quitting_SN;
   Foregrnd_Color   := Color'Val(Integer'Value(Block(5 .. 6)));
   Backgrnd_Color   := Color'Val(Integer'Value(Block(7 .. 8)));
   Border_Color     := Color'Val(Integer'Value(Block(9 .. 10)));
   Fore_Color_Digit := Block(6);
   Back_Color_Digit := Block(8);
   Normal_Colors(6) := Fore_Color_Digit;
   Normal_Colors(9) := Back_Color_Digit;
exception
   when Name_Error =>
      begin
         Create(User_File, Mode => Inout_File, Name => User_File_Name);
      exception
         when others =>
            Put("I'm sorry.  I couldn't find or create ");
            Put_Line(User_File_Name);
            Files_OK := False;
      end;
   when others =>
      Put_Line("I'm sorry.  The file " & USER_FILE_NAME & " seems to have");
      Put_Line("the wrong form or contain bad data.");
      Put_Line("You might want to delete the file and try again.");
      Put_Line("(Default values will be used.)");
      Files_OK := False;
end Open_User_File;

separate (Ada_Tutr)
procedure Show_Current_Screen is
   Half_Diff : Integer := (Highest_SN - Welcome_SN) / 2;
   Percent   : Integer := (50 * (Old_SN - Welcome_SN)) / Half_Diff;
                          -- Percentage of the course completed.  Using 50 and
                          -- Half_Diff guarantees that the numerator < 2 ** 15.
   Expanding : Boolean := False;        -- True when expanding multiple spaces.
   Prompting : Boolean := False;       -- True for first character in a prompt.
   Space     : constant String(1 .. 80) := (others => ' ');
   procedure Process_Char is separate;
begin
   Vpos := 95*(Character'Pos(Indx(SN*4 - 394)) - 32) +        -- Point to start
               Character'Pos(Indx(SN*4 - 393)) - 32;          -- of current
   Hpos := Character'Pos(Indx(SN*4 - 392)) - 32;              -- screen.
   Read(Data_File, Item => Block, From => Count(Vpos));
   if Percent < 0 then                      -- Make sure Percent is reasonable.
      Percent := 0;
   elsif Percent > 99 then
      Percent := 99;
   end if;
   while Block(Hpos) /= '[' or Expanding loop     -- [ starts the control info.
      if Expanding then
         Put(Space(1 .. Character'Pos(Block(Hpos)) - 32));
         Expanding := False;
      elsif Prompting then
         case Block(Hpos) is
            when 'b' => Put("Please type a space to go on, or B to go back.");
            when 'q' => Put("Please type a space to go on, or B or Q to go ");
                        Put("back to the question.");
            when others => Process_Char;
         end case;
         Prompting := False;
      else
         Process_Char;
      end if;
      Hpos := Hpos + 1;
      if Hpos > Block'Length then
         Vpos := Vpos + 1;
         Hpos := 1;
         Read(Data_file, Item => Block, From => Count(Vpos));
      end if;
   end loop;
end Show_Current_Screen;

separate (Ada_Tutr.Show_Current_Screen)
procedure Process_Char is
begin
   case Block(Hpos) is
      when '{'    => New_Line;                           -- { = CR-LF.
      when '@'    => Expanding := True;                  -- @ = several spaces.
      when '^'    => Put(ASCII.ESC & "[1m ");            -- ^ = bright + space.
      when '~'    => Put(Normal_Colors & ' ');           -- ~ = normal + space.
      when '%'    => Put(ASCII.ESC & "[1m");             -- % = bright.
      when '`'    => Put(Normal_Colors);                 -- ` = normal.
      when '}'    => Put(ASCII.ESC & "[24;1H");          -- } = go to line 24.
                     Prompting := True;
      when '\'    => Put(ASCII.ESC & "[7m ");            -- \ = rev. vid. + sp.
      when '$'    => if SN = 103 then                    -- $ = screen #.
                        Put(Integer'Image(Old_SN));
                     else
                        Put('$');
                     end if;
      when '#'    => if SN = 103 then                    -- # = % completed.
                        Put(Integer'Image(Percent));
                     else
                        Put('#');
                     end if;
      when others => Put(Block(Hpos));
   end case;
end Process_Char;

separate (Ada_Tutr)
procedure Get_Next_Screen_Number is
   Ctrl_Info : Block_Subtype;          -- Control info. for the current screen.
   Place     : Integer := 1;              -- Current position within Ctrl_Info.
   Input     : String(1 .. 4);                  -- Screen number that you type.
   Len       : Integer;                            -- Length of typed response.
   Valid     : Boolean;                   -- True when typed response is valid.
   procedure Set_Colors is separate;
   procedure Input_One_Keystroke is separate;
begin
   while Block(Hpos) /= ']' loop    -- Read control information from Data File.
      Hpos := Hpos + 1;
      if Hpos > Block'Length then
         Vpos := Vpos + 1;
         Hpos := 1;
         Read(Data_File, Item => Block, From => Count(Vpos));
      end if;
      Ctrl_Info(Place) := Block(Hpos);
      Place := Place + 1;
   end loop;
   if SN = 103 then                    -- Screen 103 means you typed X to exit.
      Quitting_SN := Old_SN;
   elsif SN >= Welcome_SN then              -- Save SN so you can return to it.
      Old_SN := SN;
   end if;
   if SN < 103 then                          -- Set SN to # of the next screen.
      SN := 0;      -- Set signal to end the program after screens 101 and 102.
   elsif Ctrl_Info(1) = '#' then            -- You type the next screen number.
      Valid := False;
      while not Valid loop              -- Keep trying until response is valid.
         Put("# ");                                -- Prompt for screen number.
         Input := "    ";  Get_Line(Input, Len);        -- Input screen number.
         if Input(1) = 'x' or Input(1) = 'X' or Input(1) = ASCII.ETX then
            SN := 103;                        -- Show screen 103 if you type X.
            Valid := True;                            -- X is a valid response.
         elsif Input(1) = 's' or Input(1) = 'S' then
            Set_Colors;                            -- Set colors if you type S.
            Valid := True;                            -- S is a valid response.
         else
            begin                                    -- Convert ASCII input to
               SN := Integer'Value(Input);           -- integer.  If in range,
               Valid := SN in 104 .. Highest_SN;     -- set Valid to True.  If
            exception                                -- it can't be converted
               when others => null;                  -- (e.g., illegal char.),
            end;                                     -- or it's out of range,
         end if;                                     -- leave Valid = False so
         if not Valid and Len > 0 then               -- you can try again.
            Put_Line("Incorrect number.  Please try again.");
         end if;
      end loop;
   else
      Input_One_Keystroke;
   end if;
end Get_Next_Screen_Number;

separate (Ada_Tutr.Get_Next_Screen_Number)
procedure Set_Colors is
   Bright    : constant String := ASCII.ESC & "[1m";  -- Causes high intensity.
   Keystroke : Character := 'f';             -- Single character that you type.
   Space     : constant String(1 .. 23) := (others => ' ');
begin
   while Keystroke = 'f' or Keystroke = 'b' or Keystroke = 'r' or
         Keystroke = 'F' or Keystroke = 'B' or Keystroke = 'R' loop
      Put(Clear_Scrn);                                     -- Clear the screen.
      New_Line;
      Put(Space & "The " & Bright & "foreground" & Normal_Colors);
      Put_Line(" color is now " & Color'Image(Foregrnd_Color) & '.');
      Put(Space & "The " & Bright & "background" & Normal_Colors);
      Put_Line(" color is now " & Color'Image(Backgrnd_Color) & '.');
      Put(Space & "The " & Bright & "  border  " & Normal_Colors);
      Put_Line(" color is now " & Color'Image(Border_Color) & '.');
      New_Line;
      Put_Line(Space & " Note:  Some color PCs don't have");
      Put_Line(Space & "     separate border colors.");
      New_Line;
      Put_Line(Space & "             Strike:");
      Put_Line(Space & "F to change the foreground color,");
      Put_Line(Space & "B to change the background color,");
      Put_Line(Space & "R to change the   border   color.");
      New_Line;
      Put_Line(Space & "Strike any other key to continue.");
      Get(Keystroke);                       -- Get one character from keyboard.
      if Keystroke = 'f' or Keystroke = 'F' then
         Foregrnd_Color := Color'Val((Color'Pos(Foregrnd_Color) + 1) mod 8);
         if Foregrnd_Color = Backgrnd_Color then
            Foregrnd_Color := Color'Val((Color'Pos(Foregrnd_Color) + 1) mod 8);
         end if;
      elsif Keystroke = 'b' or Keystroke = 'B' then
         Backgrnd_Color := Color'Val((Color'Pos(Backgrnd_Color) + 1) mod 8);
         if Foregrnd_Color = Backgrnd_Color then
            Backgrnd_Color := Color'Val((Color'Pos(Backgrnd_Color) + 1) mod 8);
         end if;
      elsif Keystroke = 'r' or Keystroke = 'R' then
         Border_Color := Color'Val((Color'Pos(Border_Color) + 1) mod 8);
      end if;
      Fore_Color_Digit := Character'Val(48 + Color'Pos(Foregrnd_Color));
      Back_Color_Digit := Character'Val(48 + Color'Pos(Backgrnd_Color));
      Normal_Colors(6) := Fore_Color_Digit;
      Normal_Colors(9) := Back_Color_Digit;
      Put(Normal_Colors);
      Set_Border_Color(To => Border_Color);
   end loop;
end Set_Colors;

separate (Ada_Tutr.Get_Next_Screen_Number)
procedure Input_One_Keystroke is
   Keystroke : Character;                    -- Single character that you type.
   Valid     : Boolean := False;          -- True when typed response is valid.
   Where     : Integer;              -- Location of control block in Data File.
   Search    : Character;    -- 'A' = last Outside Assignment; 'Q' = last Ques.
begin
   Put("  >");                                     -- Prompt for one character.
   while not Valid loop                 -- Keep trying until response is valid.
      Get(Keystroke);                       -- Get one character from keyboard.
      if Keystroke in 'a' .. 'z' then          -- Force upper case to simplify.
         Keystroke := Character'Val(Character'Pos(Keystroke) - 32);
      end if;
      if Keystroke = 'X' or Keystroke = ASCII.ETX then
         SN := 103;                           -- Show screen 103 if you type X.
         Valid := True;                               -- X is a valid response.
      elsif Keystroke = 'S' then
         Set_Colors;                               -- Set colors if you type S.
         Valid := True;                               -- S is a valid response.
      end if;
      Place := 1;           -- Search list of valid characters for this screen.
      Valid := Valid;             -- This statement works around a minor bug in
                                  -- ver. 1.0 of the Meridian IFORM optimizer.
      while not Valid and Ctrl_Info(Place) /= ']' loop      -- ] ends the list.
         if Keystroke = Ctrl_Info(Place) then
                  -- Typed char. found in list; get screen # from control info.
            SN := Integer'Value(Ctrl_Info(Place + 1 .. Place + 3));
            Valid := True;   -- Characters in the list are all valid responses.
         end if;
         Place := Place + 4;    -- A 3-digit number follows each char. in list.
      end loop;
      if not Valid and Keystroke /= ASCII.CR then        -- Beep if response is
         Put(ASCII.BEL);                                 -- not valid, but
      end if;                                            -- ignore CRs quietly.
   end loop;
   if SN = 98 then                       -- Go back to last Outside Assignment.
      Search := 'A';
   elsif SN = 99 then                              -- Go back to last question.
      Search := 'Q';
   elsif SN = 100 then                      -- Go back to the last screen seen.
      SN := Quitting_SN;
   end if;
   if SN = 98 or SN = 99 then
      SN := Old_SN;
      while SN > Welcome_SN and Indx(SN*4 - 395) /= Search loop
         SN := SN - 1;
      end loop;
   end if;
end Input_One_Keystroke;